00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. LOAD WITH MSFAIL.FAI
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /XXX/LK,LP,JY
00300		COMMON/XRN/RN(2000)
00400		COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00500		COMMON/POSI/STFF(-3/4),JJ2,PQ/PTR/PWDS(250),L,LL,I,IX
00600	      DIMENSION IV(78),LIST(200),XLAST(4)
00700		1,XWDS(150)
00800	C**** RN MIGHT HAVE TO BE 4000 ******
00900		COMMON /PX/POS,SX,PN(2000),Q(10000)
01000		DATA FIB/.5/
01100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01200		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(LIST,IV)
01300	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
01400	
01410		XSIG=FIB
01420		CLEF=FIB
01440		ENDLN=0
01450		KQ=0
01500	14	JT=0
01600		JR=0
01700		REWIND 1
01800	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01900		TYPE 1
02000		ACCEPT 2,NAMX
02100	213	IF(LOOKD(NAMX).GE.0)GO TO 13
02200		TYPE 88,NAMX
02300		ACCEPT 2,L
02400		IF(L.EQ.'N')GO TO 14
02500	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
02600	13	XWDS(1)=1
02610		NAMEQ=NAMX
02700		JRH=0 
02800	C  FOR REST COLLECTION
02900		IF(JT.EQ.0)RM=0
03000		L=1
03400		LK=1
03500		IF(JT.NE.0)GO TO 87
03600	CJ44	FORMAT(' TYPE TOP OUTPUT STAFF #  ',$)
03700	CJ	TYPE 44
03800	CJ	ACCEPT 5,RS
03900	CJ	RSX=RS
04000		RS=3
04100	C  SAVE UPPER STAFF NUM FOR NEXT FILE.
04200	C***	TYPE 144
04300	144	FORMAT(' STAFF SIZE = '$)
04400	C***	ACCEPT 5,STFSZ
04450		STFSZ=.9
04500	C  NON-ZERO STFSZ WILL CHANGE P5 IN ALL USED STAVES.
04600	10	IF(JT.EQ.0)GO TO 83
04700	87	NAME=NAME+2
04800		GO TO 84
04900	86	FORMAT(1XA5)
05000	3	FORMAT(' TYPE INPUT NAME, (CONT), (NOBAR)  ',$)
05100	C***83	TYPE 3
05200	C***	ACCEPT 2,NAME,JT,NBAR
05250	83	NAME='ZZZZA'
05275		JT=1
05300	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
05400		NAMZ=NAME
05500		IF(NBAR.NE.0)NBAR=-1
05600	C  ANY THIRD NUM. SUPPRESSES SCORE BARLINE FEATURE
05800	84	IF(LOOKD(NAME))GO TO 284
05900		NAME=NAMZ+256
06000		IF(LOOKD(NAME).GE.0)GO TO 20
06100		NAMZ=NAME
06200	C  FOUND NO MORE TO READ
06300	284	TYPE 86,NAME
06400		JZ=0
06500		IF(RM.NE.0)GO TO 77
06600		RM=-1
06700	4	FORMAT(' TYPE INST NAME, (RESPC?) '$)
06800		TYPE 4
06900		ACCEPT 2,RNAM,NRS
07000	C  TYPE ANY NUM AFTER INS. NAME TO STOP RHYTH RESPACING.
07100		IF(RNAM.GT.0)REREAD 5,SN
07200		IF(INM.EQ.'99')GO TO 20
07300	CC	K=SN/100.
07400		TYPE 46
07500	46	FORMAT(' TRANS. NUM. -- '$)
07600		ACCEPT 5,TR
07700	C  TRANSPOSITION BY STEPS
07800		IF(TR.GE.99)GO TO 83
07900	77	REWIND 21
08000	177	CALL IFILE(21,NAME)
08700	C  LP IS START OF RN ARRAY THIS TIME
08800		READ(21),ITEM,I,
08900		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
09000		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
09100		DO 45 K=1,ITEM
09200		J=PWDS(K)
09300		IF(RN(J+1).NE.8)GO TO 45
09400		IF(RNAM)GO TO 145
09500		IF(RN(J+2).EQ.SN)GO TO 8 
09600		GO TO 45
09700	145	R9=RN(J+9)
09800		TYPE 86,R9
09900		IF(R9.NE.RNAM)GO TO 45
10000		SN=RN(J+2)
10010		XLFT=RN(J+3)
10020	C LEFT LIMIT OF STAFF
10030		ZLFT=XLFT+.5
10040	C FOR FIRST BAR LINES.
10100		IF(STFSZ.EQ.0)STFSZ=RSTFAC(IFIX(SN))
10200	C  FOUND THE STAFF
10300		GO TO 8
10400	45	CONTINUE
10700		TYPE 16
10800	16	FORMAT(' INST. NOT FOUND'/)
10900		GO TO 10
11000	8	SIG=200
11100	C  FOR TRANSP. SECTION.
11200		RN(J+8)=0
11300	C REMOVES VERTICAL SPACER, IF ANY
11310		IF(RS.EQ.0)RN(J+8)=2.95
11320	C  PUTS ONE IN IF THIS IS LAST ONE FOR THIS FILE.
11360	
11400		DO 6 K=1,ITEM
11500		J=PWDS(K)
11600		R=RN(J+1)
11700		IF(R.NE.10)GO TO 800
11800		IF(RN(J).LT.4)GO TO 80
11900		IF(RN(J+6).GT.1.3)GO TO 6
12000	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
12100		IF(RN(J).LT.6)GO TO 80
12200	C  FOUND A NUM. IN BOX ↓↓
12300	2182	RN(J+2)=SN
12400		GO TO 81
12500	800	IF(R.NE.4)GO TO 80
12600		IF(NBAR)GO TO 80
12700		IF(RN(J).NE.2)GO TO 182
12800	C  FOUND A BAR LINE
12810		IF(RN(J+3).LT.ZLFT)GO TO 6
12820	C DROPS BAR LINE AT LEFT OF STAFF.
12900		KZ=RN(J+4)/100.
13000		RN(J+4)=1.+KZ*100.
13100	C  KZ IS FOR THICK BARS.
13200		RR=RN(J+3)
13300		DO 82 KY=K+1,ITEM
13400		KZ=PWDS(KY)
13500		IF(RN(KZ+1).NE.4)GO TO 82
13600		IF(RN(KZ).NE.2)GO TO 82
13700	C  AVOIDS DUPLICATE BARS.
13800		IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
13900		RN(KZ+2)=99
14000		RN(KZ+1)=0
14100	82	CONTINUE
14200		GO TO 81
14300	182	IF(RN(J).LT.5)GO TO 80
14400		IF(RN(J+7).GE.3)GO TO 6
14500	C  SKIP HEAVY BRACKETS.
14600	80	IF(RN(J+2).NE.SN)GO TO 6
14610		IF(R.NE.3)GO TO 3801
14620		RR=RN(J+5)
14630		IF(RN(J).LT.3)RR=0
14640		IF(RR.EQ.CLEF)GO TO 6
14650	C SKIP DUPLICATE CLEFS.
14660		IF(RR.LE.3)CLEF=RR
14670		GO TO 1800
14675	3801	IF(R.NE.17)GO TO 3800
14680		IF(RN(J+5).EQ.XSIG)GO TO 6
14690		XSIG=RN(J+5)
14700	C SKIPS DUPL. KEY SIGS.
14810	3800	IF(R.EQ.8)GO TO 6
14820	C  OMIT ALL STAVES FOR NOW
14830	1800	IF(RN(J+3).LT.XLFT)GO TO 6
14840	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
15900	81	JA=PWDS(K+1)
15910		RN(J+2)=RS
16000		DO 7 KY=J,JA-1
16100		PN(LK)=RN(KY)
16200	7	LK=LK+1
17000		L=L+1
17200		XWDS(L)=LK
17300	6	CONTINUE
17400	
17600	C***17	IF(NRS.NE.0)GO TO 200
17700	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
18100		I=1
18200		DO 243 K=1,L-1
18300		LB=XWDS(K)+1
18400		IF(PN(LB).NE.16)GO TO 243
18500		IF(PN(LB-1).LT.8)GO TO 243
18600		JL=XWDS(K-1)
18700	244	PN(LB+2)=PN(JL+3)
18800	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
18900	C  FOR SPACING PROBLEMS BELOW.
19000	243	CONTINUE
19050		M=2
19075		J=1
19100	24	RA=100000.
19200	C  POSITION
19300		DO 21 K=1,L-1
19400		JL=XWDS(K)+3
19500		R=PN(JL)
19600		IF(R.EQ.100000)GO TO 21
20100	241	IF(ABS(R-RA).GT..1)GO TO 240
20200		R=RA
20300		PN(JL)=R
20400	C  PUT IN HERE MULTI-VOICE TRAP
20500		GO TO 21
20600	240	IF(R.GT.RA)GO TO 21
20700	C  LINES THEM UP
20800		I=K
20900		RA=R
21000	21	CONTINUE
21100		IF(RA.EQ.100000)GO TO 23
21200	C  JUMP IF ALL SORTED
21300	242	JL=XWDS(I)
21400		LA=JL
21500		N=PN(JL)+3
21600	C  NEXT POINTER
21700		PWDS(M)=PWDS(M-1)+N
21800		M=M+1
21900		DO 22 K=J,J+N-1
22000		RN(K)=PN(JL)
22100	22	JL=JL+1
22200		PN(LA+3)=100000
22300	C  PUT IT ASIDE
22310		J=N+J
22315		GO TO 24
22320	23	IF(ENDLN.EQ.0)GO TO 2334
22340		R4=0
22350		R5=1000
22360		R7=RS
22370		R8=ENDLN
22380		R9=0
22390		CALL PTMOVE(RN,PWDS)
22510	2334	DO 32 K=1,IFIX(PWDS(L))-1
22520		KQ=KQ+1
22530	32	Q(KQ)=RN(K)
22535		ENDLN=ENDLN+200
22540		L=1
22560		LK=1
22570		GO TO 10
22580	
42810	20	K=1
42820		KK=1
42830	220	JJ=Q(K)+3
42840		PN(KK)=K
42850	C NEW POINTER
42860		K=K+JJ
42870		KK=KK+1
42880		IF(K.LT.KQ)GO TO 220
42890		PN(KK)=K
42900		L=KK
42907	C  DELETES EXTRA BAR LINES, ETC.
42910		CALL RESTS
42920	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
42930		K=1
42940		L=1
42950		LL=0
42960		LK=1
42970	221	IF(Q(IFIX(PN(K))+1))GO TO 321
42980		DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
42990		LL=LL+1
43000	421	Q(LL)=Q(KL)
43010		LK=LK+1
43020		PN(LK)=LL+1
43030	321	K=K+1
43040		IF(K.LT.KK)GO TO 221
43045		L=LK-1
43047	C  L=NUMBER OF ITEMS FOR RHY RECONS.
43200	123	LB=1 
43214		JFST=0
43228		POS=0
43242		R5X=0
43256	C  NEXT RECONSTITUTES RHYTHM
43270	25	N=PN(LB)
43284		R=Q(N+1)
43298		IF(TR.EQ.0)GO TO 51
43312		IF(R.EQ.1)GO TO 52
43326		IF(R.EQ.5)GO TO 52
43340		IF(R.EQ.6)GO TO 52
43354		IF(R.EQ.17)GO TO 117
43368	51	JR=0
43382		IF(R.LE.4)GO TO 430
43396		IF(R.LT.17)GO TO 30
43410	C LOOKS FOR 17 AND 18, KSIG AND METER.
43424	430	IF(R.NE.1)GO TO 230
43438		IF(Q(N).LT.7)GO TO 630
43452		IF(Q(N+9))GO TO 30
43466	C SKIPS NON-LEDGER LINE NOTES.
43480		GO TO 130
43494	630	JR=-1
43508		GO TO 130
43522	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
43536	230	IF(R.NE.2)GO TO 130
43550		IF(Q(N).LT.5)JR=-1
43564	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
43578	130	IF(RCLEF(Q(N)))GO TO 30
43592	CJ SKIPS NON-CLEFS
43606		S=Q(N+3)
43620		LA=LB
43634	26	LA=LA+1
43648		IF(LA.GE.L)GO TO 30
43662	C  FIND NEXT IMPORTANT ITEM
43676		NA=PN(LA)
43690		RR=Q(NA+1)
43704		IF(RR.LE.4)GO TO 134
43718		IF(RR.LT.17)GO TO 26
43732	134	IF(RR.NE.4)GO TO 34
43746		IF(Q(NA).NE.2)GO TO 26
43760	C  USES ONLY NOTES, RESTS, BARS, CLEFS
43774	34	IF(RCLEF(Q(NA)))GO TO 26
43788	CJ SKIPS NON-CLEFS
43802		RX=Q(NA+3)
43816	C  POSITION OF NEXT ITEM
43830		IF(S.EQ.RX)GO TO 26
43844		IF(R.LT.3)GO TO 235
43858		IF(R.GE.17)P=4.
43872	C  PUT IN FOR LARGE KSIGS LATER.
43886		IF(R.EQ.4)P=2.
43900		IF(R.EQ.3)P=6.
43914		IF(Q(NA+5).GE.100.)P=5.
43928	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
43942		IF(RR.EQ.17)P=P+3.
43956	C  IF NEXT(RR) IS KSIG, ADD SPACE.
43970		GO TO 335
43984	235	K=9
43998		IF(R.EQ.2)K=7
44012		P=Q(N+K)
44026		IF(JR)P=1
44040	C  ASSUMES QUARTER VALUE IF NON WAS GIVEN
44054		P=P+(.125-P)*FIB
44068	135	P=P*15.
44082	C  FINDS RHYTH IN P9 OR P7(REST)
44096	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
44110		IF(P)GO TO 30
44124	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
44138	335	SX=S+P-RX
44152		IF(SX.EQ.0)GO TO 30
44166		R5X=R5X+SX
44180	C  SPACE DIFFERENCE
44194	
44208		LL=0
44222		R7=RS
44236		IF(SX)GO TO 29
44250	2900	R4=RX
44264		R5=100000  
44278		R8=SX
44292		R9=0
44306	C  ADJUST REST OF LINE
44320		CALL PTMOVE(Q,PN)
44334		IF(SX)GO TO 30
44348	29	R4=S
44362		R5=RX
44376		R8=S
44390		R9=RX+SX
44404	C  ADJUST STUFF BETWEEN POINTS
44418		CALL PTMOVE(Q,PN)
44432		IF(SX)GO TO 2900
44446	
44460	30	LB=LB+1
44474		IF(LB.LT.L)GO TO 25
44488	C  GO BACK IF MORE SPACING TO DO
44502		P8=0
44516		LL=0
44530	C***	IF(XLFT.EQ.0)GO TO 600
44544	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
44558		R5=10000.
44572		R7=RS
44586		R8=-XLFT
44600		R4=-101
44614		R9=0
44628		CALL PTMOVE(Q,PN)
44642		CALL LINELN(STFSZ)
44656	C  BREAKS IT UP INTO LINES.
44670	C***** NEXT IS TEMPORARY
44684		J=1
44698		CALL OFILE(1,NAMX)
44712		LL=PN(L+1)
44726	2929	WRITE(1),L,LL,
44740		1 (PN(K),K=1,L+1),(Q(K),K=1,LL-1),J,J,J,J,RSTFAC,STFF,IV,STFF
44754		STOP
44800	2	FORMAT(A5,2I)
44900	5	FORMAT(5F)
45000	
45100	
45200	52	A=Q(N+4)
45300		Q(N+4)=A+TR
45400	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
45500		X=Q(N+5)
45600		IF(Q(N+1).EQ.1)GO TO 11
45700	C  COULD ADD STEM REVERSE HERE.
45800		Q(N+5)=X+TR
45900		GO TO 51
46000	11	A=AMOD(A,100.)
46100		IF(TR.NE.4)GO TO 1101
46200		IF(AMOD(A,7.0).EQ.0)GO TO 101
46300	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
46400	C  NEXT IS FOR Bb TRANSP.
46500		B=AMOD(A+7.0,7.0)
46600		IF(B.EQ.0)GO TO 101
46700		IF(B.NE.3)GO TO 51
46800	C  FINDS ORIG. E OR B
46900	101	M=AMOD(X,10.0)
47000	C  FINDS ACCID.
47100		X=X-M
47200	C  STEM DIR. AND DECI.
47300		B=3.
47400	C CHANGES FLAT TO NATURAL SIGN.
47500		IF(M.NE.0)GO TO 118
47600		IF(SIG.NE.200)GO TO 51
47700	C  GO BACK IF A KEY SIG. IS PRESENT
47800	118	IF(M.EQ.3)B=2
47900	C  NO PROVISION YET FOR ## OR bb
48000	2101	Q(N+5)=X+B
48100		GO TO 51
48200	117	SIG=Q(N+5)
48300		IF(TR.EQ.1)SIG=SIG+2
48400		IF(TR.EQ.4)SIG=SIG+1
48500	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
48600	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
48700		IF(SIG.NE.0)GO TO 217
48800		IF(TR.EQ.1)SIG=-102
48900		IF(TR.EQ.3)SIG=-101
49000	217	Q(N+5)=SIG
49100		GO TO 51
49200		END